home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earcd / -archivi / -recent2 / amicad_2.00.lha / AmiCAD / ARexx / Recopier.AmiCAD < prev    next >
Text File  |  1999-02-25  |  3KB  |  162 lines
  1. /* Clonage d'un composant, en "augmentant sa référence"
  2.    Version 1.00: 22 décembre 1998
  3.    Version 1.01: 25 Février 1999 (modif appel ASKNUM)
  4. $VER: 1.01 (© R.Florac, 25 février 1999) */
  5.  
  6. options results     /* indispensable pour récupérer le résultat des macros */
  7.  
  8. signal on error     /* pour l'interception des erreurs */
  9. signal on syntax
  10.  
  11. 'FIRSTSEL'
  12. o=result
  13. if o=0 then do
  14.     'MESSAGE("Sélectionnez le"+CHR(10)+"composant à recopier!")'
  15.     exit
  16. end
  17.  
  18. type=0
  19. do while type=0
  20.     'TYPE('o')'
  21.     select
  22.     when result=1 then do
  23.         type=1
  24.         leave
  25.     end
  26.     when result=4 then do
  27.         type=4
  28.         leave
  29.     end
  30.     when result=11 then do
  31.         type=11
  32.         leave
  33.     end
  34.     when result=12 then do
  35.         type=12
  36.         leave
  37.     end
  38.     otherwise nop
  39.     end
  40.     'NEXTSEL('o')'; o=result
  41.     if o=0 then do
  42.     'MESSAGE("Sélection incorrecte")'
  43.     exit
  44.     end
  45. end
  46.  
  47. if type=1 then 'READTEXT(GETREF('o'))'
  48. else 'READTEXT('o')'
  49. ref=result
  50. j=numero_reference(ref)
  51. ref=reference(ref)
  52. 'WIDTH(0)'; l=(result%10)*10
  53. 'HEIGHT(0)'; h=(result%10)*10
  54. 'COL(0)'; x0=result
  55. 'LINE(0)'; y0=result
  56. 'SELECT("Sens de la copie"+CHR(10)+"Vers le bas"+CHR(10)+"Vers la droite"+CHR(10)+"Vers le haut"+CHR(10)+"Vers la gauche")'
  57. sens=result
  58. if sens < 1 then exit
  59. 'ASKNUM("Combien de fois"+CHR(10)+"voulez-vous effectuer"+CHR(10)+"l''opération?",2)'
  60. n=result
  61. if n<1 then exit
  62. 'SELECT("Pas entre les copies"+CHR(10)+"10 pixels"+CHR(10)+"20 pixels"+CHR(10)+"30 pixels"+CHR(10)+"Automatique"+CHR(10)+"Spécifié")'
  63. pas = result
  64. select
  65.     when pas=1 then pas=0
  66.     when pas=2 then pas=10
  67.     when pas=3 then pas=20
  68.     when pas=4 then do
  69.     if sens=1 | sens=3 then pas=h
  70.     else pas=l
  71.     end
  72.     when pas=5 then do
  73.     'ASKNUM("Pas entre les copies",10)'
  74.     pas=result
  75.     end
  76.     otherwise exit
  77. end
  78.  
  79. 'COPY(5)'           /* sauvegarde des éléments à copier */
  80. 'SAVEALL(-1)'
  81. do i=1 to n
  82.     select
  83.     when sens=1 then do    /* Copie vers le bas */
  84.         yy=y0+(10+pas)*i
  85.         yy=(yy%10)*10
  86.         'PASTE(5,'x0','yy')'
  87.     end
  88.     when sens=2 then do
  89.         xx=x0+(10+pas)*i
  90.         xx=(xx%10)*10
  91.         'PASTE(5,'xx','y0')'
  92.     end
  93.     when sens=3 then do
  94.         yy=y0-(10+pas)*i
  95.         yy=(yy%10)*10
  96.         'PASTE(5,'x0','yy')'
  97.     end
  98.     otherwise do
  99.         'MESSAGE("Pas encore implémenté!")'
  100.     end
  101.     end
  102.     if ref ~= "" then do
  103.     j=j+1
  104.     k=indice(type)
  105.     if type=1 then 'SETREF('k',"'ref||j'"):UNMARK(-1)'
  106.     else 'SETTEXT('k',"'ref||j'"):UNMARK(-1)'
  107.     end
  108. end
  109.  
  110. exit
  111.  
  112. indice: procedure
  113.     parse arg type
  114.     'FIRSTSEL'
  115.     o=result
  116.     do while o>0
  117.     'TYPE('o')'
  118.     select
  119.         when result=type then return o
  120.         otherwise nop
  121.     end
  122.     'NEXTSEL('o')'; o=result
  123.     end
  124.     return 0
  125.  
  126. reference: procedure
  127.     parse arg ref
  128.     i=length(ref)
  129.     do while i>1
  130.     c=substr(ref,i,1)
  131.     if datatype(c)=NUM then ref=left(ref,i-1)
  132.     else return ref
  133.     i=i-1
  134.     end
  135.     return ref
  136.  
  137. numero_reference: procedure
  138.     parse arg ref
  139.     i=length(ref)
  140.     r=0
  141.     rang=1
  142.     do while i>1
  143.     c=substr(ref,i,1)
  144.     if datatype(c)=NUM then do
  145.         r=r+c*rang
  146.         rang=rang*10
  147.     end
  148.     else return r
  149.     i=i-1
  150.     end
  151.     return r
  152.  
  153. /* Traitement des erreurs, interruption du programme */
  154. syntax:
  155. erreur=RC
  156. 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  157. exit
  158.  
  159. error:
  160. 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  161. exit
  162.